home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / read_wave.pro < prev    next >
Text File  |  1997-07-08  |  14KB  |  452 lines
  1. ; $Id: read_wave.pro,v 1.4 1997/01/15 03:11:50 ali Exp $
  2. ;
  3. ; Copyright (c) 1990-1997, Research Systems, Inc.  All rights reserved.
  4. ;       Unauthorized reproduction prohibited.
  5.  
  6. FUNCTION getword, BIN = BIN
  7.  
  8. COMMON waverdln, unit
  9.  
  10. ON_IOERROR, done
  11.  
  12. IF (KEYWORD_SET(BIN)) THEN BEGIN
  13.   wordlen = 0L
  14.   READU, unit, wordlen
  15.   theword = bytarr(wordlen)
  16.   READU, unit, theword
  17. ENDIF ELSE BEGIN
  18.   filestat = FSTAT(unit)
  19.   current = filestat.cur_ptr
  20.   buffsize = 100 < (filestat.size - current)
  21.   linebuffer = bytarr(100)
  22.   READU, unit, linebuffer
  23.   i = 0
  24.   WHILE (linebuffer(i) EQ 32) OR (linebuffer(i) EQ 10) DO i = i + 1
  25.   wordstart = i
  26.   WHILE (linebuffer(i) NE 32) AND (linebuffer(i) NE 10) DO i = i + 1
  27.   theword = linebuffer(wordstart:i - 1)
  28.   POINT_LUN, unit, current + i
  29. ENDELSE
  30.  
  31. return, string(theword)
  32.  
  33. RETURN, STRCOMPRESS(STRING(theword(WHERE(theword NE 10))), /REMOVE_ALL)
  34.  
  35. done: RETURN, ""
  36.  
  37. END
  38.  
  39.  
  40. FUNCTION getdef, BIN = BIN, BLOCK = BLOCK
  41.  
  42. COMMON waverdln, unit
  43.  
  44. ON_IOERROR, done
  45.  
  46. IF (KEYWORD_SET(BIN)) THEN BEGIN
  47.   IF (KEYWORD_SET(BLOCK)) THEN BEGIN
  48.     def = 0L
  49.     READU, unit, def
  50.     IF (def NE 257L) THEN MESSAGE, "Error, " +$
  51.         "definition expected in binary read (" + def + ")"
  52.   ENDIF
  53.   type = 0L
  54.   READU, unit, type
  55. ENDIF ELSE BEGIN
  56.   IF (KEYWORD_SET(BLOCK)) THEN BEGIN
  57.     def = getword(BIN = BIN)
  58.     IF (def EQ "") THEN GOTO, done
  59.     IF (STRMID(def, 0, 1) EQ "#") THEN BEGIN
  60.       ignore = ""
  61.       READF, unit, ignore
  62.       def = getword(BIN = BIN)
  63.     ENDIF
  64.     IF (def NE "define") THEN $
  65.       MESSAGE, "Error, definition expected in text read (" + def + ")"
  66.   ENDIF
  67.   type = getword(BIN = BIN)
  68.   CASE type OF
  69.     "vdata":         type = 258L
  70.     "reg_topology":     type = 259L
  71.     "elem_samp":     type = 260L
  72.     "irr_topology":    type = 262L
  73.     "count":        type = 263L
  74.     "elems":        type = 264L
  75.     "reg_grid":     type = 265L
  76.     "grid_samp":     type = 266L
  77.     "origin":         type = 267L
  78.     "step":        type = 268L
  79.     "irr_grid":        type = 270L
  80.     "node_vdata":    type = 271L
  81.     "mesh":         type = 273L
  82.     "mesh_topology":    type = 274L
  83.     "mesh_grid":    type = 275L
  84.     "volume":         type = 276L
  85.     "volume_mesh":    type = 277L
  86.     "volume_vdata":    type = 278L
  87.     ELSE: BEGIN
  88.         MESSAGE, type + " was the unrecognized type"
  89.       END
  90.   ENDCASE
  91. ENDELSE
  92.  
  93. RETURN, type
  94.  
  95. done: RETURN, -1L
  96.  
  97. END
  98.  
  99.  
  100. FUNCTION getnum, BIN = BIN
  101.  
  102. COMMON waverdln, unit
  103.  
  104. IF (KEYWORD_SET(BIN)) THEN BEGIN
  105.   num = 0L
  106.   READU, unit, num
  107. ENDIF ELSE BEGIN
  108.   num = LONG(getword(BIN = BIN))
  109. ENDELSE
  110.   return, num
  111. END
  112.  
  113. FUNCTION readarray, len
  114.  
  115. COMMON waverdln, unit
  116.  
  117. line = ""
  118. READF, unit, line
  119. endofline = fstat(unit)
  120. current = endofline.cur_ptr
  121.  
  122. valueline = SHIFT(BYTE(STRCOMPRESS(line)), -1)
  123. spaces = WHERE(valueline EQ 32, numspaces)
  124. IF (numspaces NE 0) THEN BEGIN
  125.   values = INTARR(len)
  126.   last = 0
  127.   FOR i = 0, numspaces - 1 DO BEGIN
  128.     values[i] = STRING(valueline[last:spaces[i] - 1])
  129.     last = spaces[i]
  130.   ENDFOR
  131. ENDIF
  132.  
  133. return, values
  134. END
  135.  
  136.  
  137. PRO read_wave, filename, variables, names, dimensions, $
  138.         MESHNAMES = MESHNAMES
  139. ;+
  140. ; NAME:
  141. ;    READ_WAVE
  142. ; PURPOSE:
  143. ;    READ a .wave or .bwave file created by the Advanced Data Visualizer
  144. ;    into an series of IDL variables.
  145. ; CALLING SEQUENCE:
  146. ;    READ_WAVE, FILE, VARIABLES, NAMES, DIMENSIONS
  147. ; INPUTS:
  148. ;    FILE = Scalar string giving the name of the Wavefront file to write.
  149. ; KEYWORD PARAMETERS:
  150. ;    MESHNAMES = The name of the mesh used in the Wavefront file
  151. ;        for each variable.
  152. ; OUTPUTS:
  153. ;    VARIABLES = Upon return, this variable contains a block of the 
  154. ;        variables contained in the wavefront file.  Since each
  155. ;        variable in a wavefront file can have more than one field
  156. ;        (for instance, a vector variable has 3 fields), the fields
  157. ;        of each variable make up the major index into the variable 
  158. ;        block.  For instance, if a Wavefront file had one scalar 
  159. ;        variable and one vector variable, the scalar would be
  160. ;        extracted as follows:
  161. ;
  162. ;            vector_scalar = variables[0,*,*,*]
  163. ;
  164. ;        and the vector variable would be extracted as follows:
  165. ;
  166. ;            vector_variable = variables[1:3,*,*,*]
  167. ;
  168. ;        To find the dimensions of the returned variable, see the
  169. ;        description below regarding DIMENSIONS
  170. ;
  171. ;    NAMES = Upon return, this variable contains the string names of each
  172. ;        variable contained in the file.
  173. ;    DIMENSIONS = Upon return, this variable is a long array that describes
  174. ;        how many fields in the large returned variable block each
  175. ;        variable occupies.  In the above example of one scalar variable
  176. ;        followed by a vector variable, the dimension variable would 
  177. ;        be:
  178. ;            DIMENSIONS = [1,3]
  179. ;        So the first field of the returned variable block would be
  180. ;        the scalar variable and the following 3 fields would comprise
  181. ;        the vector variable.
  182. ; RESTRICTIONS:
  183. ;    This routine only preserved the structure of the variables if they
  184. ;    are regularly grided variables.  
  185. ; MODIFICATION HISTORY:
  186. ;    Written July 16, 1991, by Steve Richards.
  187. ;-
  188. ; Copyright (c) 1990, Research Systems, Inc.  All rights reserved.
  189. ;    Unauthorized reproduction prohibited.
  190. ;
  191.  
  192. COMMON waverdln, unit
  193.  
  194. IF (KEYWORD_SET(DEBUG)) THEN DEBUG = 1 ELSE DEBUG = 0
  195.  
  196. volnum = 0
  197. voldesclist = 0
  198. voldesc = {vldesc,    name:"", $
  199.               volmeshdesc:"", $
  200.               voldata:""}
  201. meshnum = 0
  202. meshdesclist = 0
  203. meshdesc = {mshdesc,    name:"", $
  204.             topdesc:"", $
  205.             griddesc:""}
  206. topnum = 0
  207. topdesclist = 0
  208. topdesc = {tpdesc,    name:"", $
  209.             elem_samp:intarr(8)}
  210. gridnum = 0
  211. griddesclist = 0
  212. griddesc = {grddesc,    name:"", $
  213.             grid_samp:intarr(8)}
  214.  
  215. datafieldnum = 0
  216. datafieldlist = 0
  217. datafield = {dtfld,    name:"", $
  218.             size:0}
  219.  
  220. variables = 0
  221.  
  222. OPENR, unit, filename, /GET_LUN
  223.  
  224. adot = STRPOS(filename, ".")
  225.  
  226. WHILE (adot NE -1) DO BEGIN
  227.   dot = adot
  228.   adot = STRPOS(filename, ".", adot + 1)
  229. END
  230.  
  231. ext = STRMID(filename, dot + 1, 100)
  232.  
  233. IF (ext EQ "bwave") THEN BIN = 1 ELSE BIN = 0
  234.  
  235. ON_IOERROR, done
  236.  
  237. curval = getdef(BIN = BIN, /BLOCK)
  238. WHILE (curval NE -1) DO BEGIN                ;while new blocks to
  239.   CASE (curval) OF                    ;the definition type
  240.  
  241.     258L:BEGIN                        ;definevdata
  242.        newnumvars = getnum(BIN = BIN)
  243.          newvarnames = strarr(newnumvars)
  244.          newvardims = intarr(newnumvars) + 1
  245.          FOR i = 0, newnumvars - 1 DO BEGIN        ;determine variable
  246.            newvarnames[i] = getword(BIN = BIN)    ;names and dimensional
  247.            parenth = STRPOS(newvarnames[i], "(", 0)    ;information if it is
  248.            IF(parenth NE -1) THEN BEGIN        ;present
  249.              newvardims[i] = FIX(STRMID(newvarnames[i], $
  250.                         parenth + 1, $
  251.                         10))
  252.            newvarnames[i] = STRMID(newvarnames[i], 0, parenth)
  253.            datafieldloc = where(datafieldlist.name EQ newvarnames[i])
  254.            datafieldlist[datafieldloc].size = $
  255.             datafieldlist[datafieldloc].size * newvardims[i]
  256.            ENDIF
  257.          ENDFOR
  258.        newnumdatalines = getnum(BIN = BIN)
  259.          newvars = FLTARR(TOTAL(newvardims), newnumdatalines)
  260.        IF (KEYWORD_SET(BIN)) THEN $
  261.          READU, unit, newvars $
  262.        ELSE $
  263.          READF, unit, newvars
  264.        varsize = SIZE(variables)
  265.        IF (varsize[0] EQ 0) THEN BEGIN
  266.          variables = newvars
  267.          numvars = newnumvars
  268.          varnames = newvarnames
  269.          vardims = newvardims
  270.        ENDIF ELSE BEGIN
  271.          newvariables = FLTARR(varsize[1] + $
  272.             TOTAL(newvardims), newnumdatalines)
  273.          newvariables[0:varsize[1]-1,*] = variables
  274.          newvariables[varsize[1]:*,*] = newvars
  275.          variables = newvariables
  276.          numvars = numvars + newnumvars
  277.          varnames = [varnames, newvarnames]
  278.          vardims = [vardims, newvardims]
  279.        ENDELSE
  280.        END
  281.  
  282.     259L:BEGIN                        ;definereg_topology
  283.            topnum = topnum + 1
  284.            IF(KEYWORD_SET(topdesclist)) THEN $
  285.              topdesclist = [topdesclist, topdesc] $
  286.        ELSE topdesclist = REPLICATE(topdesc, 1)
  287.            topdesclist[topnum - 1].name = getword(BIN = BIN)
  288.        IF (getdef(BIN = BIN) NE 260L) THEN $    ;if not elem_samp
  289.          MESSAGE, "incorrect format, elem_samp should" + $
  290.             " follow define reg_topology"
  291.        topdesclist[topnum - 1].elem_samp[0] = getnum(BIN = BIN)
  292.        topdesclist[topnum - 1].elem_samp[1] = getnum(BIN = BIN)
  293.        topdesclist[topnum - 1].elem_samp[2] = getnum(BIN = BIN)
  294.        END
  295.  
  296.     262L:BEGIN                        ;define irr_topology
  297.        gridname = getword(BIN = BIN)
  298.        countdef = getdef(BIN = BIN)
  299.        IF (countdef NE 263L) THEN $
  300.         MESSAGE, "incorrect format, count should " +$
  301.             "follow define irr_topology"
  302.        count = getnum(BIN = BIN)
  303.        elemsdef = getdef(BIN = BIN)
  304.        IF (elemsdef NE 264L) THEN $
  305.         MESSAGE, "incorrect format, elems should " +$
  306.             "follow count definition"
  307.        elemsname = getword(BIN = BIN)
  308.        elemscount = getnum(BIN = BIN)
  309.        toss = intarr(4,elemscount)
  310.        IF (KEYWORD_SET(BIN)) THEN $
  311.          READU, unit, toss $
  312.        ELSE $
  313.          READF, unit, toss
  314.        toss = 0
  315.        END
  316.  
  317.     265L:BEGIN                        ;define reg_grid
  318.            gridnum = gridnum + 1
  319.            IF(KEYWORD_SET(griddesclist)) THEN $
  320.              griddesclist = [griddesclist,griddesc] $
  321.        ELSE griddesclist = REPLICATE(griddesc, 1)
  322.            griddesclist[gridnum - 1].name = getword(BIN = BIN)
  323.        IF (getdef(BIN = BIN) NE 266L) THEN $    ;if not grid_samp
  324.          MESSAGE, "incorrect format, grid_samp should" + $
  325.             " follow define reg_grid"
  326.        griddesclist[gridnum - 1].grid_samp[0] = getnum(BIN = BIN)
  327.        griddesclist[gridnum - 1].grid_samp[1] = getnum(BIN = BIN)
  328.        griddesclist[gridnum - 1].grid_samp[2] = getnum(BIN = BIN)
  329.        IF (getdef(BIN = BIN) NE 267L) THEN $    ;if not origin
  330.          MESSAGE, "incorrect format, origin" + $
  331.             " follow define grid_samp"
  332.        orig = fltarr(3)
  333.        orig[0] = getnum(BIN = BIN)
  334.        orig[1] = getnum(BIN = BIN)
  335.        orig[2] = getnum(BIN = BIN)
  336.        IF (getdef(BIN = BIN) NE 268L) THEN $    ;if not step
  337.          MESSAGE, "incorrect format, step" + $
  338.             " follow define origin"
  339.        steps = FLTARR(3)
  340.        steps[0] = getnum(BIN = BIN)
  341.        steps[1] = getnum(BIN = BIN)
  342.        steps[2] = getnum(BIN = BIN)
  343.        END
  344.  
  345.     270L:BEGIN                        ;defineirr_grid
  346.        gridname = getword(BIN = BIN)
  347.        griddef = getdef(BIN = BIN)
  348.        IF (griddef NE 271) THEN $
  349.         MESSAGE, "incorrect format, grid_vdata should " +$
  350.             "follow define irr_grid"
  351.        datafieldnum = datafieldnum + 1
  352.            IF(KEYWORD_SET(datafieldlist)) THEN $
  353.              datafieldlist = [datafieldlist, datafield] $
  354.        ELSE datafieldlist = REPLICATE(datafield, 1)
  355.            datafieldlist[datafieldnum - 1].name = getword(BIN = BIN)
  356.        datafieldlist[datafieldnum - 1].size = -1
  357.        END
  358.  
  359.     273L:BEGIN                        ;definemesh
  360.            meshnum = meshnum + 1
  361.            IF(KEYWORD_SET(meshdesclist)) THEN $
  362.              meshdesclist = [meshdesclist, meshdesc] $
  363.            ELSE meshdesclist = REPLICATE(meshdesc, 1)
  364.            meshdesclist[meshnum - 1].name = getword(BIN = BIN)
  365.        IF (getdef(BIN = BIN) NE 274L) THEN $    ;if not mesh_topology
  366.          MESSAGE, "incorrect format, mesh_topology should" + $
  367.             " follow define mesh"
  368.        meshdesclist[meshnum - 1].topdesc = getword(BIN = BIN)
  369.        IF (getdef(BIN = BIN) NE 275L) THEN $    ;if not mesh_grid
  370.          MESSAGE, "incorrect format, mesh_grid" + $
  371.             " follow define mesh_topology"
  372.        meshdesclist[meshnum - 1].griddesc = getword(BIN = BIN)
  373.        END
  374.  
  375.     276L:BEGIN                        ;definevolume
  376.          volnum = volnum + 1
  377.              IF(KEYWORD_SET(voldesclist)) THEN $
  378.                voldesclist = [voldesclist,voldesc] $
  379.          ELSE voldesclist = REPLICATE(voldesc, 1)
  380.              voldesclist[volnum - 1].name = getword(BIN = BIN)
  381.          IF (getdef(BIN = BIN) NE 277L) THEN $    ;if not define vol_mesh
  382.            MESSAGE, "incorrect format, volume_mesh should" + $
  383.             " follow define volume"
  384.          voldesclist[volnum - 1].volmeshdesc = getword(BIN = BIN)
  385.          IF (getdef(BIN = BIN) NE 278L) THEN $     ;if not define vol_dvata
  386.            MESSAGE, "incorrect format, volume_vdata should" + $
  387.             " follow define volume_mesh"
  388.          voldesclist[volnum - 1].voldata = getword(BIN = BIN)
  389.          datafieldnum = datafieldnum + 1
  390.              IF(KEYWORD_SET(datafieldlist)) THEN $
  391.                datafieldlist = [datafieldlist, datafield] $
  392.          ELSE datafieldlist = REPLICATE(datafield, 1)
  393.              datafieldlist[datafieldnum - 1].name = $
  394.             voldesclist[volnum - 1].name
  395.          datafieldlist[datafieldnum - 1].size = 1
  396.        END
  397.     ELSE: print, "no case for type ", curval
  398.   ENDCASE
  399.   curval = getdef(BIN = BIN, /BLOCK)
  400. ENDWHILE
  401.  
  402. done:
  403.  
  404. FREE_LUN, unit
  405.  
  406. nomesh = 0
  407.  
  408. FOR i = 0, volnum - 1 DO BEGIN
  409.   IF (meshnum EQ 0) OR (gridnum EQ 0) OR (topnum EQ 0) THEN BEGIN
  410.     nomesh = 1
  411.   ENDIF ELSE BEGIN
  412.     meshloc = WHERE(voldesclist[i].volmeshdesc EQ $
  413.            meshdesclist.name, meshfound)
  414.     dataloc = WHERE(voldesclist[i].voldata EQ $
  415.             varnames, datafound)
  416.     IF ((NOT meshfound) OR (NOT datafound)) THEN nomesh = 1
  417.     toploc = WHERE(meshdesclist[meshloc].topdesc EQ $
  418.            topdesclist.name, topfound)
  419.     gridloc = WHERE(meshdesclist[meshloc].griddesc EQ $
  420.            griddesclist.name, gridfound)
  421.     IF ((NOT topfound) OR (NOT gridfound))THEN nomesh = 1
  422.  
  423.     griddims = griddesclist[gridloc].grid_samp[ $
  424.       WHERE(griddesclist[gridloc].grid_samp NE 0)]
  425.   ENDELSE
  426. ENDFOR
  427.  
  428. IF NOT(nomesh) THEN BEGIN
  429.   variables = reform(variables, [TOTAL(vardims), griddims])
  430.   MESHNAMES = meshdesclist.name
  431. ENDIF
  432.  
  433. names = voldesclist.name
  434.  
  435. startindex = 0
  436. FOR i = 0, datafieldnum - 1 DO BEGIN
  437.   IF(datafieldlist[i].size GE 1) THEN BEGIN
  438.     IF (KEYWORD_SET(validdata)) THEN BEGIN
  439.       validdata = [validdata, INDGEN(datafieldlist[i].size) + startindex]
  440.       dimensions = [dimensions, datafieldlist[i].size]
  441.     ENDIF ELSE BEGIN
  442.       validdata = INDGEN(datafieldlist[i].size) + startindex
  443.       dimensions = datafieldlist[i].size
  444.     ENDELSE
  445.   ENDIF
  446.   startindex = startindex + ABS(datafieldlist[i].size)
  447. ENDFOR
  448.  
  449. variables = variables[validdata, *, *, *]
  450.  
  451. END
  452.